home *** CD-ROM | disk | FTP | other *** search
/ Netware Super Library / Netware Super Library.iso / ipx_netx / set_ip / set-ip.pas < prev    next >
Pascal/Delphi Source File  |  1992-10-22  |  8KB  |  255 lines
  1. program setip;
  2. {$m 5000,0,1000}
  3.  
  4. uses dos, crt, novell, strnttt5, MiscTTT5;
  5.  
  6. type
  7.     Pchar = ^char;
  8.  
  9. const datecode = '14 October 92';
  10.  
  11. var
  12.   logfile : text;
  13.   logfilename : string;
  14.   debug : boolean;
  15.   subnet_start, subnet_end : integer;
  16.   subnet_base : string;
  17.   prog_name : string;
  18.   option : array [1..6] of string;
  19.   count : integer;
  20.   valid_ip : boolean;
  21.   open_count : integer;
  22.   handle : longint;
  23.   retcode : integer;
  24.   ip_address : string;
  25.   name, realname : string;
  26.   station : integer;
  27.     NewEnv0, NewEnv, p : Pchar;
  28.     i : integer;
  29.     EnvPtr : ^word;        {Will point at PefixSeg:$2C}
  30.     SaveEnvSeg : word;
  31.     PromptIndex : integer;
  32.  
  33. procedure write_debug(debug_string : string);
  34. begin
  35.  writeln('DEBUG: ',debug_string);
  36.  writeln('Press ENTER to continue....'); readln;
  37. end;
  38.  
  39. function Env_Size : integer;
  40.     {Returns number of bytes needed for existing environment}
  41. var    i,sz : integer;
  42. begin
  43.     sz := 0;
  44.     for i := 1 to EnvCount do
  45.         sz := sz + 1 + length(EnvStr(i));
  46.     sz := sz + 4 + length(Paramstr(0));  {Program path at end}
  47.     Env_Size := sz;
  48. end;
  49.  
  50. function VarIndex(v : string) : integer;
  51.     {Returns index of 'v=' string in environment}
  52. var    i : integer;
  53. begin
  54.     for i := 1 to length(v) do v[i] := UpCase(v[i]);
  55.     v := v + '=';
  56.     i := 1;
  57.     while (i<=EnvCount) and (copy (EnvStr(i),1,length(v))<>v) do
  58.         i := i+1;    {Assumes variable names upper case in env}
  59.     if i>EnvCount then i:=0;
  60.     VarIndex := i;
  61. end;
  62.  
  63. procedure Put0Term (var p:Pchar; s:string);
  64.     {Copies s to 0-terminated string at p, and makes p point at char
  65.      after last in destination}
  66. var    i : integer;
  67. begin
  68.     for i := 1 to length(s) do
  69.       begin
  70.         p^ := s[i];
  71.         inc(p);
  72.       end;
  73.     p^ := #0;
  74.     inc(p);
  75. end;
  76.  
  77.  
  78. procedure set_environment;
  79. begin
  80.         {Get memory for copy of environment}
  81.     GetMem (NewEnv0, Env_Size + 16 {space to go up to next segment} +
  82.         length('NCSA01=') + length('myip~'+ip_address) + 1 {space for expansion});
  83.     NewEnv := ptr (seg(NewEnv0^)+1, 0);    {Make sure 0 offset}
  84.  
  85.     PromptIndex := VarIndex('NCSA01');
  86.     p := NewEnv;
  87.     for i := 1 to EnvCount do if i<>PromptIndex then
  88.         Put0Term (p, EnvStr(i));    {Copy all but prompt}
  89.  
  90.     Put0Term (p, 'NCSA01=myip~'+ip_address);    {Insert new variable}
  91.  
  92.     Put0Term (p, '');        {Place tail of environment}
  93.     Put0Term (p, #1#0+ParamStr(0));    {Word(1) indicates one item, then}
  94.                     { program path}
  95.     EnvPtr := ptr (PrefixSeg, $2c);
  96.  
  97.     SaveEnvSeg := EnvPtr^;        {Declare new environment}
  98.     EnvPtr^ := seg(NewEnv^);
  99.  
  100.         {Get memory for copy of environment}
  101.     GetMem (NewEnv0, Env_Size + 16 {space to go up to next segment} +
  102.         length('MYIP=') + length(ip_address) + 1 {space for expansion});
  103.     NewEnv := ptr (seg(NewEnv0^)+1, 0);    {Make sure 0 offset}
  104.  
  105.     PromptIndex := VarIndex('MYIP');
  106.     p := NewEnv;
  107.     for i := 1 to EnvCount do if i<>PromptIndex then
  108.         Put0Term (p, EnvStr(i));    {Copy all but prompt}
  109.  
  110.     Put0Term (p, 'MYIP='+ip_address);    {Insert new variable}
  111.  
  112.     Put0Term (p, '');        {Place tail of environment}
  113.     Put0Term (p, #1#0+ParamStr(0));    {Word(1) indicates one item, then}
  114.                     { program path}
  115.     EnvPtr := ptr (PrefixSeg, $2c);
  116.  
  117.     SaveEnvSeg := EnvPtr^;        {Declare new environment}
  118.     EnvPtr^ := seg(NewEnv^);
  119. end;
  120.  
  121. procedure reset_environment;
  122. begin
  123.     EnvPtr^ := SaveEnvSeg;        {Restore environment segment}
  124.                     {Probably not important, but safer}
  125. end;
  126.  
  127. procedure help;
  128. begin
  129.  clrscr;
  130.  writeln('SET-IP compiled ',datecode,'          mbramwel@novell.business.uwo.ca');
  131.  writeln;
  132.  writeln('Set-IP checks the novell network to see if a range of ip addresses are');
  133.  writeln('being used.  The first un-used ip address is grabbed and an environment');
  134.  writeln('variable called NCSA01 is created for use with NCSA.  A variable called');
  135.  writeln('MYIP is created for use with ms-kermit.');
  136.  writeln;
  137.  writeln('A logfile is stored in Z:\SYSTEM\TCPIP\month.LOG  Make sure people have ');
  138.  writeln('write access to SYS:SYSTEM/TCPIP');
  139.  writeln;
  140.  writeln('SET-IP <ip-base> <subnet-start> <subnet-stop> <program-name> <options>');
  141.  writeln;
  142.  writeln('Example:');
  143.  writeln('set-ip 129.100.22 200 220 f:\apps\ncsa\telbin.exe -h y:config.tel hydra.uwo.ca');
  144.  writeln;
  145.  writeln('The above will check from 129.100.22.200 to 129.100.22.220 looking for a free');
  146.  writeln('address and if it finds one, it will run NCSA Telnet reading the config file');
  147.  writeln('stored on drive Y:  We only keep one copy of config.tel on the server.');
  148.  writeln;
  149.  writeln('Sample    TELNET.BAT');
  150.  writeln('--------------------');
  151.  writeln('f:\apps\ncsa\ipxpkt 0x60');
  152.  writeln('set-ip 129.100.29 120 125 f:\apps\ncsa\telbin.exe -h f:\apps\ncsa\config.tel %1');
  153.  
  154.  halt;
  155. end;
  156.  
  157. procedure check_for_ip; { scan novell for semaphore ip address }
  158. begin
  159.  for count := subnet_start to subnet_end do
  160.  begin
  161.    ip_address := subnet_base + '.' + int_to_str(count);
  162.    if debug then write_debug('Trying to find '+ip_address);
  163.    open_semaphore(ip_address, 1, open_count, handle, retcode);
  164.    if debug then write_debug('Semaphore Retcode='+int_to_str(retcode));
  165.    if debug then write_debug('Open count='+int_to_str(open_count));
  166.    if open_count = 1 then
  167.      begin { we have an address! }
  168.        valid_ip := true;
  169.      end
  170.    else
  171.      begin { address is in-use }
  172.        close_semaphore(handle, retcode);
  173.      end;
  174.   if valid_ip then exit;
  175.  end;
  176. end;
  177.  
  178. procedure setup;
  179. begin
  180.   debug := false;
  181.   if paramstr(1) = '' then help; { base ip address  xxx.xxx.xxx }
  182.   if paramstr(2) = '' then help; { subnet starting point }
  183.   if paramstr(3) = '' then help; { subnet ending point }
  184.   if paramstr(4) = '' then help; { name of program to shell }
  185.   subnet_base := paramstr(1);
  186.   subnet_start := str_to_int(paramstr(2));
  187.   subnet_end := str_to_int(paramstr(3));
  188.   if subnet_start = 0 then help;
  189.   if  subnet_end  = 0 then help;
  190.   for count := 1 to 6 do option[count] := paramstr(count+4);
  191.   valid_ip := false;
  192.   check_for_ip;
  193. end;
  194.  
  195. procedure log_it(info: string);
  196. begin
  197.   logfilename := 'z:\system\tcpip\'+extractwords(2,1,date)+'.log';
  198.   assign(logfile,logfilename);
  199.   if exist(logfilename) then append(logfile) else rewrite(logfile);
  200.   writeln(logfile, name+' '+date+' '+time+' '+info);
  201.   close(logfile);
  202. end;
  203.  
  204. procedure run_software;
  205. var shell_string : string;
  206. begin
  207.   if debug then write_debug('we will now try to run the stuff');
  208.   getstation(station,retcode);
  209.   getuser(station,name,retcode);
  210.   get_realname(name,realname,retcode);
  211.   if realname = '' then realname := name;
  212.   writeln(' TCP/IP Network Address for ',realname,' = ',ip_address);
  213.   {shell_string := ' -e "myip='+ip_address+'"';}
  214.   shell_string := '';
  215.   set_environment;
  216.   if getenv('NCSA01') <> 'myip~'+ip_address
  217.      then
  218.      begin
  219.        beep;
  220.        writeln;
  221.        writeln('Unable to set your IP Address.');
  222.        writeln('One possible problem could be "not enough environment space".');
  223.        writeln;
  224.        writeln('Add the following line to your config.sys on your bootdisk,');
  225.        writeln;
  226.        writeln('shell=command.com /e:512 /p');
  227.        writeln;
  228.        writeln('Tested with dos version 3.3 and up.');
  229.        halt;
  230.        end;
  231.   for count := 5 to 9 do
  232.       if paramstr(count) <> '' then shell_string := shell_string + ' ' + paramstr(count);
  233.   if debug then write_debug(shell_string);
  234.   swapvectors;
  235.   log_it(ip_address+' '+paramstr(4)+' '+shell_string);
  236.   exec(getenv('COMSPEC'), '/C '+paramstr(4)+' '+shell_string);
  237. {  exec(getenv('COMSPEC'), '/C ' + getenv('COMSPEC'));}
  238.   if doserror <> 0 then writeln('Dos Error ',doserror);
  239.   swapvectors;
  240. reset_environment;
  241. end;
  242.  
  243. procedure display_message;
  244. begin
  245.  writeln('There are ',subnet_end - subnet_start + 1,' connections available for this server.');
  246.  writeln;
  247.  writeln('Sorry, all of the network connections are in use.  Please try again later.');
  248.  writeln('If you see this message often, please contact the network manager.');
  249. end;
  250.  
  251. begin
  252.  setup;
  253.  if valid_ip then run_software else display_message;
  254. end.
  255.